home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Purity / Purity #22 (1994-01-19)(Diesel)(DE)[WB].zip / Purity #22 (1994-01-19)(Diesel)(DE)[WB].adf / APrint_V1.1 / APrint_V1.1.p < prev    next >
Text File  |  1994-01-17  |  55KB  |  1,721 lines
  1. PROGRAM APrint; {V1.1}
  2.  
  3. {------------------------------------------------------------------------}
  4. { *** APrint_V1.1 ***        USES OS2 KickPascal-Includes
  5.  
  6.   © & P 11/1993 bis 1/1994 by Falk Zühlsdorff (PackMAN)
  7.   FREEWARE: wenn nichts an Programm/Source/Anleitung verändert wird ;
  8.             folgende Files & der Icons müssen enthalten sein:
  9.             APrint_V1.1, APrint.dok
  10.  
  11.  
  12.   Ideen, Spenden (A4000/Star LS 5ex/IDEK 21"Monitor [grins])an:
  13.  
  14.             PackMAN
  15.             c/o Falk Zühlsdorff
  16.             Lindenberg 66
  17.             98693 Ilmenau/Thür.                                          }
  18. {------------------------------------------------------------------------}
  19.  
  20. Uses INTUITION,GRAPHICS;
  21. {$INCL 'dos.lib','asl.lib'}
  22.  
  23. VAR ArpBase: PTR;
  24.  Library ArpBase:
  25.   -294:Function Filerequest(a0:PTR):Long;
  26.  END;
  27.  
  28. {------------------------------------------------------------------------}
  29.  
  30. CONST Last:=49;                                {Begrenzung für Einträge}
  31.       Kenn:='APrint_V1.1_Config';
  32.       dk:='APrint_V1.1_Data';
  33. {------------------------------------------------------------------------}
  34. TYPE Gadfeld1=array[0..19] of gadget;
  35.      Stringfeld1=array[0..9] of string[12];        {für Booleangadgets}
  36.      ituifeld=array[0..19] of Intuitext;
  37.  
  38.      {****************}
  39.  
  40.      SGadfeld=array[0..6] of gadget;
  41.      Stringfeld2=array[0..6] of string[52];    {für Stringgadgets}
  42.      SGifeld=array[0..6] of StringInfo;
  43.  
  44.      {****************}
  45.  
  46.      ipffeld=array[0..9] of long;              {Für Images(Gads)}
  47.      iradiofeld=array[1..18] of long;
  48.  
  49.      {****************}
  50.  
  51.      rec=RECORD
  52.           name1,name2,Nr,Ort:STRING[31];
  53.           Kz:STRING[12];
  54.          END;
  55.  
  56.      {****************}
  57.  
  58.      zhfeld=array[5..7] of integer;              {Farben}
  59.      Stringtyp=string[100];
  60. {------------------------------------------------------------------------}
  61.  
  62. VAR Scr : ^Screen;
  63.     Vp  : ViewPort;
  64.     Win : ^Window;
  65.     OWin: ^Window;
  66.     RP  : ^RastPort;                   {Screen-/Window-/Msg-/}
  67.     Prc : ^Process;                    {Hilfsvariablen}
  68.     PrcH: Ptr;
  69.     Msg : ^IntuiMessage;
  70.     i:byte;
  71.     ex,strw,NLQu,
  72.     ergebnis,frei,tosave,
  73.     toload:boolean;STATIC;
  74.     Akt:^Gadget;
  75.     leerZh:integer;STATIC;
  76.     gfx:long;STATIC;
  77.  
  78.     {****************}
  79.  
  80.     G:Gadfeld1;STATIC;                 {normale Booleangadgets}
  81.     S2:Stringfeld1;STATIC;
  82.     Gt:ituifeld;STATIC;
  83.  
  84.     {****************}
  85.  
  86.     SG:SGadfeld;STATIC;
  87.     SGt:Stringfeld2;STATIC;             {Stringgadets}
  88.     SGi:SGifeld;STATIC;
  89.  
  90.     {****************}
  91.  
  92.     ipfeil:^ipffeld;STATIC;
  93.     ipf,radio1,radio2:image;STATIC;     {Images für Gadgets}
  94.     iradio1,iradio2:^iradiofeld;STATIC;
  95.  
  96.     {****************}
  97.  
  98.     ein:array[0..Last] of rec;STATIC;   {Datenverwaltung}
  99.     line,ig,cg,help:byte;STATIC;
  100.     autoh,autofirst,asl,arp,fehl,
  101.     neues:boolean;STATIC;
  102.     lab1,lab2:string;STATIC;
  103.     filelib:text;STATIC;
  104.     Datei,Pfad,rufname:Stringtyp; STATIC;
  105.  
  106.     {****************}
  107.  
  108.     ah,bh,ch,dh:zhfeld;STATIC;          {Farben}
  109.  
  110. {--------------------------------------------------------------------------}
  111.  
  112. PROCEDURE loadcon;
  113. VAR load:text;STATIC;
  114.     s:string;STATIC;
  115.     p:integer;STATIC;
  116.  
  117. BEGIN
  118.  fehl:=false;
  119.  p:=0;
  120.  reset(load,'SYS:S/AprintV1.1.config');
  121.  if IOResult=0 then
  122.   BEGIN
  123.     readln(load,s);
  124.     if s=Kenn then
  125.      BEGIN
  126.       for i:=5 to 7 do
  127.        BEGIN readln(load,s); VAL (s,ah[i],p);
  128.              if p<>0 then BEGIN fehl:=true; exit; END;END;
  129.       for i:=5 to 7 do
  130.        BEGIN readln(load,s); VAL (s,bh[i],p);
  131.              if p<>0 then BEGIN fehl:=true; exit; END;END;
  132.       for i:=5 to 7 do
  133.        BEGIN readln(load,s); VAL (s,ch[i],p);
  134.              if p<>0 then BEGIN fehl:=true; exit; END;END;
  135.       for i:=5 to 7 do
  136.        BEGIN readln(load,s); VAL (s,dh[i],p);
  137.              if p<>0 then BEGIN fehl:=true; exit; END;END;
  138.        readln(load,s); if s='1' then NLQu:=true
  139.                     else if s='0' then NLQu:=false
  140.                           else BEGIN fehl:=true; exit;END;
  141.        readln(load,s); if s='1' then autoh:=true
  142.                     else if s='0' then autoh:=false
  143.                           else BEGIN fehl:=true; exit;END;
  144.        readln(load,s); if autoh then rufname:=s else rufname:='';
  145.        readln(load,s); pfad:=s;
  146.        readln(load,s); datei:=s;
  147.        readln(load,s); VAL (s,leerZh,p); if p<>0 then fehl:=true;
  148.        close(load);
  149.      END
  150.      else BEGIN fehl:=true;close(load); END
  151.     END
  152.    else fehl:=true;
  153.  END;
  154.  
  155. {------------------------------------------------------------------------}
  156.  
  157. PROCEDURE Radio;
  158.  
  159. BEGIN
  160.  iradio1:=PTR(ALLOC_MEM(SizeOf(iradiofeld),2));
  161.  iradio1^:=iradiofeld(%00000000000000100000000000000000,
  162.                       %00000000000000110000000000000000,
  163.                       %00000000000000011000000000000000,
  164.                       %00000000000000011000000000000000,
  165.                       %00000000000000011000000000000000,
  166.                       %00000000000000011000000000000000,
  167.                       %00000000000000011000000000000000,
  168.                       %00000000000000110000000000000000,
  169.                       %00011111111111100000000000000000,
  170.  
  171.                       %00111111111111000000000000000000,
  172.                       %01100000000000000000000000000000,
  173.                       %11000000000000000000000000000000,
  174.                       %11000000000000000000000000000000,
  175. { 2. Bitplane }       %11000000000000000000000000000000,
  176.                       %11000000000000000000000000000000,
  177.                       %11000000000000000000000000000000,
  178.                       %01100000000000000000000000000000,
  179.                       %0010000000000000000000000000000);
  180.  
  181.  iradio2:=PTR(ALLOC_MEM(SizeOf(iradiofeld),2));
  182.  iradio2^:=iradiofeld(
  183.  
  184.                       %00111111111110000000000000000000,
  185.                       %01100000000000000000000000000000,
  186.                       %11000111111100000000000000000000,
  187.                       %11001111111110000000000000000000,
  188.                       %11001111111110000000000000000000,
  189.                       %11001111111110000000000000000000,
  190.                       %11000111111100000000000000000000,
  191.                       %01100000000000000000000000000000,
  192.                       %00100000000000000000000000000000,
  193.  
  194.                       %00000000000001000000000000000000,
  195.                       %00000000000000110000000000000000,
  196.                       %00000111111100011000000000000000,
  197.                       %00001111111110011000000000000000,
  198. { 2. Bitplane }       %00001111111110011000000000000000,
  199.                       %00001111111110011000000000000000,
  200.                       %00000111111100011000000000000000,
  201.                       %00000000000000110000000000000000,
  202.                       %00011111111111100000000000000000);
  203.  
  204.  radio1:=IMAGE(0,0,17,9,2,iradio1,3,0,NIL);
  205.  radio2:=IMAGE(0,0,17,9,2,iradio2,3,0,NIL);
  206. END;
  207.  
  208. {------------------------------------------------------------------------}
  209.  PROCEDURE Pfeilimage;
  210.  
  211.  BEGIN
  212.   ipfeil:=PTR(ALLOC_MEM(SizeOf(ipffeld),2));
  213.   ipfeil^:=ipffeld   (%00000000000000000000000000000000,
  214.                       %00000111111000000000000000000000,
  215.                       %00001100000110000000000000000000,
  216.                       %00001100011111100000000000000000,
  217.                       %00001100001111000000000000000000,
  218.                       %00001100000110000000000000000000,
  219.                       %00001100000000000000000000000000,
  220.                       %00001100000110000000000000000000,
  221.                       %00000111111100000000000000000000,
  222.                       %00000000000000000000000000000000);
  223.  
  224.  ipf:=IMAGE(0,0,32,10,1,ipfeil,1,0,NIL);
  225. END;
  226.  
  227. {------------------------------------------------------------------------}
  228.  
  229. PROCEDURE SRand (ziel:p_window;x,y,b,h:cardinal);
  230.  
  231. TYPE  type1=array[0..5] of cardinal;
  232.       type2=array[0..5] of cardinal;
  233.       type3=array[0..5] of cardinal;
  234.       type4=array[0..5] of cardinal;
  235.  
  236. VAR   F1:type1;
  237.       F2:type2;
  238.       F3:type3;
  239.       F4:type4;
  240.       Bor1,Bor2,Bor3,Bor4:BORDER;
  241.  
  242. BEGIN
  243.  F1:=type1(b-1,0,0,0,0,h);            {Gadgetumrandungen}
  244.  F2:=type2(b,1,b,h,1,h);
  245.  F3:=type3(b-1,1,1,1,1,h-1);
  246.  F4:=type4(b-1,1,b-1,h-1,2,h-1);
  247.  Bor1:=BORDER(0,0,2,0,0,3,^F1,^Bor2);
  248.  Bor2:=BORDER(0,0,1,0,0,3,^F2,^Bor3);
  249.  Bor3:=BORDER(0,0,1,0,0,3,^F3,^Bor4);
  250.  Bor4:=BORDER(0,0,2,0,0,3,^F4,NIL);
  251.  DRAWBORDER(ziel^.RPort,^Bor1,x,y);
  252. END;
  253.  
  254. {------------------------------------------------------------------------}
  255.  
  256. PROCEDURE GRand (ziel:p_window;x,y,b,h:cardinal);
  257.  
  258. TYPE  type1=array[0..5] of cardinal;
  259.       type2=array[0..5] of cardinal;
  260.       type3=array[0..3] of cardinal;
  261.  
  262. VAR   F1:type1;
  263.       F2:type2;
  264.       F3:type3;
  265.       Bor1,Bor2,Bor3:BORDER;
  266.  
  267. BEGIN
  268.  F1:=type1(b-1,0,0,0,0,h);            {Gadgetumrandungen}
  269.  F2:=type2(b,0,b,h,1,h);
  270.  F3:=type3(b-1,1,b-1,h-1);
  271.  Bor1:=BORDER(0,0,2,0,0,3,^F1,^Bor2);
  272.  Bor2:=BORDER(0,0,1,0,0,3,^F2,^Bor3);
  273.  Bor3:=BORDER(0,0,1,0,0,2,^F3,NIL);
  274.  DRAWBORDER(ziel^.RPort,^Bor1,x,y);
  275. END;
  276.  
  277. {------------------------------------------------------------------------}
  278.  
  279. PROCEDURE message(laber:String);
  280. BEGIN
  281.  SGt[6]:=laber;
  282.  REFRESHGADGETS(^SG[6],Win,nil);
  283. END;
  284.  
  285. {------------------------------------------------------------------------}
  286. PROCEDURE Fehlerreq;
  287.  
  288. VAR fehler:boolean; STATIC;
  289.     gadlab1,gadlab2:IntuiText;STATIC;
  290. BEGIN
  291.     gadlab1:=INTUITEXT(2,1,0,5,3,NIL,'Klar !!!',NIL);
  292.     gadlab2:=INTUITEXT(2,1,0,5,3,NIL,'Was ???',NIL);
  293.     fehler:=AUTOREQUEST(NIL,^lab1,^gadlab1,^gadlab2,0,0,330,80);
  294. END;
  295. {------------------------------------------------------------------------}
  296.  
  297. FUNCTION OS2:BOOLEAN;
  298.  VAR lib:p_library;
  299.  BEGIN
  300.   lib:=intuitionbase;
  301.   OS2:=(lib^.lib_version>=36);
  302.  END;
  303. {------------------------------------------------------------------------}
  304. PROCEDURE suchelib;
  305. BEGIN
  306.  asl:=FALSE;
  307.  arp:=FALSE;
  308.  if OS2 then
  309.   BEGIN
  310.    reset(filelib,'sys:libs/asl.library');
  311.    IF IORESULT=0 THEN asl:=true
  312.                  ELSE
  313.                   BEGIN
  314.                    reset(filelib,'sys:libs/arp.library');
  315.                    IF IORESULT=0 THEN arp:=true;
  316.                   END;
  317.    END
  318.   else
  319.    BEGIN
  320.     reset(filelib,'sys:libs/arp.library');
  321.     IF IORESULT=0 THEN  arp:=true
  322.    END;
  323.    if asl or arp then close(filelib);
  324. END;
  325.  
  326. {------------------------------------------------------------------------}
  327.  
  328. PROCEDURE ASLREQ(titel:STR; VAR Datei,Pfad:Stringtyp);;
  329.  
  330. VAR Req      : p_FileRequester;STATIC;
  331.     Tags     : ARRAY[0..4] OF TagItem;STATIC;
  332.     Cancel   : Boolean;STATIC;
  333.     titeldata: string;STATIC;
  334.  
  335. BEGIN
  336.    titeldata:=titel;
  337.       Tags[0].ti_Tag:=ASL_Hail;
  338.       Tags[0].ti_Data:=titeldata;
  339.       Tags[1].ti_Tag:=ASL_Window;
  340.       Tags[1].ti_Data:=Win^; {Hä hä}
  341.       Tags[2].ti_Tag:=ASL_File;
  342.       Tags[2].ti_Data:=Datei;
  343.       Tags[3].ti_Tag:=ASL_Dir;
  344.       Tags[3].ti_Data:=Pfad;
  345.       Tags[4].ti_Tag:=TAG_DONE;
  346.  
  347.       { Requester-Struktur anlegen lassen }
  348.       Req:=AllocAslRequest(ASL_FileRequest,^Tags);
  349.       rufname:='';
  350.       IF Req<>NIL THEN
  351.          BEGIN
  352.           IF RequestFile(Req) THEN
  353.            BEGIN
  354.             Datei:=req^.rf_File;
  355.             Pfad:=req^.rf_Dir;
  356.             IF (Pfad<>'') AND (Pfad[length(Pfad)]<>':') AND
  357.                (Pfad[length(Pfad)]<>'/')
  358.              THEN Pfad:=Pfad+'/';
  359.              rufname:=Pfad+Datei;
  360.            END;
  361.           FreeAslRequest(Req);
  362.          END
  363.         ELSE displaybeep(nil);
  364. END;
  365. {------------------------------------------------------------------------}
  366. PROCEDURE filereq(titel:STR; VAR Datei,Pfad:Stringtyp);
  367.  
  368. TYPE  Filerequester=RECORD
  369.        FR_Hail      : STR;
  370.        FR_File      : PTR;
  371.        FR_Dir       : PTR;
  372.        FR_Window    : p_window;
  373.        FR_Funcflags : Byte;
  374.        FR_Reserved  : Byte;
  375.        FR_Function  : PTR;
  376.        FR_Reseved2  : LONG;
  377.       END;
  378.  VAR   requester: Filerequester;
  379.        p_Datei, p_Pfad : PTR;
  380.        ok:boolean;
  381.  BEGIN
  382.   p_Datei:=^Datei;
  383.   p_Pfad :=^Pfad;
  384.   ok:=true;
  385.   rufname:='';
  386.   requester:=Filerequester(Titel,p_Datei,p_Pfad,Win,50,0,^ok,1);
  387.   IF Filerequest(^requester)<>0 THEN  {inkl. Aufruf}
  388.    BEGIN
  389.   IF Pfad<>"" THEN
  390.   IF (pos(":",Pfad)<>Strlen(Pfad)) AND (pfad[(strlen(Pfad))]<>'/')
  391.    THEN Pfad:=Pfad+"";
  392.     IF (Datei<>"") AND (pfad<>'') AND (pfad[strlen(pfad)]<>':')
  393.                                       THEN rufname:=Pfad+'/'+Datei
  394.                                       ELSE rufname:=pfad+datei;
  395.     if ok then ok:=false;
  396.     if not ok then exit;
  397.    END;
  398.  END;
  399. {------------------------------------------------------------------------}
  400. PROCEDURE ToCLI;
  401.  
  402. VAR   CliWin : ^Window;
  403.       CliMsg : ^IntuiMessage;
  404.       e: boolean;STATIC;
  405.  
  406. BEGIN
  407.  CliWin:=Open_Window(200,0,200,10,$0203,MOUSEBUTTONS+_CLOSEWINDOW,ACTIVATE+
  408.   WINDOWDRAG+ WINDOWDEPTH+RMBTRAP+WINDOWCLOSE,'--> APrint <--',Nil,200,10,
  409.   200,10);
  410.   if CliWin=Nil then
  411.       exit;
  412.  ScreenToBack(Scr);
  413.  ex:=false;
  414.  REPEAT
  415.   CliMsg:=Wait_Port(CliWin^.UserPort);
  416.   CliMsg:=Get_Msg(CliWin^.UserPort);
  417.   case CliMsg^.Class of
  418.    MOUSEBUTTONS : if (CliMsg^.Code and $80)=0 then
  419.                   if (CliMsg^.Code and 1)=1   then
  420.                     e:=true;
  421.    _CLOSEWINDOW : BEGIN e:=true; ex:=true; END;
  422.   else; end;
  423.   Reply_Msg(CliMsg);
  424.  UNTIL e;
  425.  Close_Window(CliWin);
  426.  if not ex then ScreenToFront(Scr);
  427.  END;
  428.  
  429. {------------------------------------------------------------------------}
  430.  
  431. PROCEDURE Loeschen;
  432. BEGIN
  433.  frei:=true;
  434.  if SGt[0]<>'' then
  435.   BEGIN SGt[0]:=''; frei:=false END;
  436.  if SGt[1]<>'' then
  437.   BEGIN SGt[1]:=''; frei:=false END;
  438.  if SGt[2]<>'' then
  439.   BEGIN SGt[2]:=''; frei:=false END;
  440.   if SGt[3]<>'' then
  441.   BEGIN SGt[3]:=''; frei:=false END;
  442.   if SGt[4]<>'' then
  443.   BEGIN SGt[4]:=''; frei:=false END;
  444.  
  445.   if not frei
  446.    then BEGIN REFRESHGADGETS(^SG[0],Win,nil);
  447.               if (not toload) and (not neues)
  448.                 then  message('Eintrag gelöscht.'); END
  449.    else if (not toload) and (not neues)
  450.           then
  451.             message('Wozu Löschen, der Eintrag ist doch frei ?!?');
  452. END;
  453.  
  454. {----------------------------------------------------------------------}
  455. PROCEDURE Wechseln;
  456.  
  457.            BEGIN
  458.              if line<4 then INC(line) else line:=0;
  459.               for i:=0 to 9 do
  460.               BEGIN
  461.                S2[i]:='          ';  {nur löschen}
  462.                Gt[i]:=IntuiText(1,0,1,11,5,nil,^S2[i],nil);
  463.               END;
  464.               REFRESHGADGETS(Win^.Firstgadget,Win,nil);
  465.               for i:=0 to 9 do
  466.                BEGIN
  467.                 frei:=true;
  468.                 if  (ein[(10*line)+i].name1)<>'' then frei:=false else
  469.                 if  (ein[(10*line)+i].name2)<>'' then frei:=false else
  470.                 if  (ein[(10*line)+i].Nr)<>''    then frei:=false else
  471.                 if  (ein[(10*line)+i].Ort)<>''   then frei:=false else
  472.                 if  (ein[(10*line)+i].Kz)<>''    then frei:=false;
  473.                 if frei then S2[i]:='frei'
  474.                    else S2[i]:=ein[(10*line)+i].Kz;
  475.                 help:=(10-(STRLEN(S2[i])));
  476.                 Gt[i]:=IntuiText(1,0,1,((4*help)+11),5,nil,^S2[i],nil);
  477.                END;
  478.                case line of
  479.                 0: message('Adressen: 1 bis 10');
  480.                 1: message('Adressen: 11 bis 20');
  481.                 2: message('Adressen: 21 bis 30');
  482.                 3: message('Adressen: 31 bis 40');
  483.                 4: message('Adressen: 41 bis 50');
  484.                else; end;
  485.               REFRESHGADGETS(Win^.Firstgadget,Win,nil);
  486.               delay(10);
  487.              END;
  488.  
  489. {------------------------------------------------------------------------}
  490.  
  491. PROCEDURE Drucken;
  492. CONST ESC:=CHR(27);
  493.       Test:='PRT:';
  494. VAR LST:text;STATIC;
  495.     outfile:BPTR;STATIC;
  496.     anzahl,abc:long;STATIC;
  497.     strg:String[2];STATIC;
  498.     raum,raum2:string;STATIC;
  499.  
  500. BEGIN
  501.  frei:=true;
  502.  for i:=0 to  3 do if frei then
  503.                     if SGt[i]<>'' then frei:=false;
  504.  if not frei
  505.   then
  506.    BEGIN
  507.     message('Versuche zu drucken / drucke ...');
  508.     raum:='';
  509.     raum2:='';
  510.     if leerZh>0 then for i:=leerZh downto 0 do raum:=(raum+' ');
  511.     case leerZh of
  512.        1..6: raum2:=raum+' ';
  513.       7..11: raum2:=raum+'  ';
  514.      12..17: raum2:=raum+'   ';
  515.      17..23: raum2:=raum+'    ';
  516.      24..28: raum2:=raum+'     ';
  517.      29..34: raum2:=raum+'      ';
  518.      35..40: raum2:=raum+'       ';
  519.     else;end;
  520.     strg:=' ';
  521.     outfile:=Open(Test,Mode_OLDFILE);                {Drucker ansprechen}
  522.     if outfile<>0 then
  523.      BEGIN
  524.       anzahl:=dosWrite(outfile,^strg,3);  {Online okay ...}
  525.       if anzahl=3 then
  526.        BEGIN
  527.         abc:=DOSClose(outfile);
  528.         rewrite(LST,'PRT:');
  529.         if IOResult=0 then
  530.          BEGIN
  531.           writeln(LST,ESC,'#1');
  532.           if NLQu then write(LST,ESC,'[2"z')        {NLQ}
  533.                   else write(LST,ESC,'[1"z');       {Draft}
  534.           write(LST,ESC,'[2v',ESC,'[1p',ESC,'[4w',
  535.                     ESC,'[4m');                     {hoch/unterstr.}
  536.           writeln(LST,raum,raum,SGt[5],ESC,'[1v',ESC,
  537.                       '[3w',ESC,'[24m');            {normal+nichtunter}
  538.           write(LST,ESC,'[0w',ESC,'[1w',ESC,'[1p'); {Pica }
  539.           write(LST,ESC,'(B');                      {Zeichesatz USA}
  540.           write(LST,ESC,'[2z');                     {1/8 Zoll}
  541.           writeln(LST);
  542.           writeln(LST);
  543.           for i:=0 to 2 do
  544.            BEGIN
  545.             writeln(LST,raum2,SGt[i]);
  546.             writeln(LST);
  547.            END;
  548.             write(LST,ESC,'[1m');                   {Fettdruck}
  549.             writeln(LST,raum2,SGt[3],ESC,'[22m');   {+Fettdr. aus}
  550.             message('Ausgedruckt');
  551.           close(LST);
  552.         END else BEGIN abc:=DosClose(Outfile); message('Printer trouble 1'); END
  553.        END else BEGIN abc:=DosClose(Outfile); message('Printer trouble 2'); END
  554.      END else BEGIN abc:=DosClose(Outfile); message('Printer trouble 3'); END
  555.     END else message('Kein Daten für Ausdruck vorhanden ...');
  556. END;
  557.  
  558.  
  559. {------------------------------------------------------------------------}
  560.  
  561. PROCEDURE PosGadTx(SGadNr:byte,xstr:string);{CenterText für AddyGads 0..9}
  562.  
  563. VAR l:byte;STATIC;
  564.  
  565. BEGIN
  566.   l:=(10-(STRLEN(xstr)));
  567.   S2[SGadNr]:='          ';  {nur löschen}
  568.   Gt[SGadNr]:=IntuiText(1,0,1,11,5,nil,^S2[SGadNr],nil);
  569.   REFRESHGADGETS(Win^.Firstgadget,Win,nil);
  570.   S2[SGadNr]:=xstr;
  571.   Gt[SGadNr]:=IntuiText(1,0,1,((4*l)+11),5,nil,^S2[SGadNr],nil);
  572.   REFRESHGADGETS(Win^.Firstgadget,Win,nil);
  573. END;
  574.  
  575. {------------------------------------------------------------------------}
  576.  
  577. PROCEDURE Infoline;
  578.  VAR  x:boolean;STATIC;
  579.        wi:^window;STATIC;
  580.        GadiMsg:^IntuiMessage;STATIC;
  581.        GADi:Gadget;STATIC;
  582.        RPi:^RastPort;STATIC;
  583.  BEGIN
  584.   wi:=Open_Window(0,10,640,246,1,GADGETUP+GADGETDOWN+RAWKEY,RMBTRAP+BORDERLESS+
  585.                    ACTIVATE,NIL,Scr,640,246,640,246);
  586.    GRand(wi,0,0,638,244);
  587.    Gadi:=Gadget(Nil,0,0,640,246,GADGHNONE,RELVERIFY+GADGIMMEDIATE,
  588.                BOOLGADGET,NIL,NIL,NIL,0,NIL,1,NIL);
  589.    wi^.firstgadget:=^Gadi;
  590.    REFRESHGADGETS(wi^.Firstgadget,wi,nil);
  591.    RPi:=wi^.RPort;
  592.                      {++++ Die Laberzeilen ++++}
  593.  
  594.    SetAPen(RPi,3); Move(RPi,247,16);gfx:=_Text(RPi,'*** Copyright ***',17);
  595.    SetAPen(RPi,2);Move(RPi,125,32);gfx:=_Text(RPi,
  596.    'Erstellt mit KickPascal 2.12 von Maxon Computer.',48);
  597.     SetAPen(RPi,1); Move(RPi,35,56);gfx:=_Text(RPi,
  598.    'Das Programm dient zum Verwalten und Drucken von bis zu 50 Anschriften.',71);
  599.    Move(RPi,35,64);gfx:=_Text(RPi,
  600.    'Also für den Heimgebrauch ist es ausreichend und außerdem FREEWARE.,',67);
  601.    Move(RPi,35,72);gfx:=_Text(RPi,
  602.    'Folgendes muß beachtet werden:',30);
  603.    SetAPen(RPi,3);Move(RPi,35,88);gfx:=_Text(RPi,
  604.    'Es müssen die Files: APrint_V1.1 / APrint.Dok (incl. Icons) enthalten',69);
  605.    Move(RPi,35,96);gfx:=_Text(RPi,
  606.    'sein und es dürfen keine Veränderungen vorgenommen werden. Die Auf-',67);
  607.    Move(RPi,35,104);gfx:=_Text(RPi,
  608.    'nahme in eine PD-Serie ist unbedingt VORHER mit mir abzusprechen.',65);
  609.    SetAPen(RPi,2);Move(RPi,35,120);gfx:=_Text(RPi,
  610.    'Vertrieb: PD-Händler nicht über 2 DM (Verbote siehe APrint.Dok)',63);
  611.    SetAPen(RPi,1);Move(RPi,35,136);gfx:=_Text(RPi,
  612.    'Gruß und Dank an: Pascal-Serie PURITY, Diesel, Rogersoft, J.Tröger',66);
  613.    Move(RPi,35,144);gfx:=_Text(RPi,
  614.    '                  Janosh (Dreamer), A. Voget',44);
  615.    SetAPen(RPi,3);Move(RPi,55,160);gfx:=_Text(RPi,
  616.    '     Spenden (z.B. A4000/Star LS 5ex/IDEK 21"), Ideen, Bugs an:',63);
  617.    Move(RPi,287,176);gfx:=_Text(RPi,'PackMAN',7);
  618.    Move(RPi,239,184);gfx:=_Text(RPi,'c/o Falk Zühlsdorff',19);
  619.    Move(RPi,263,192);gfx:=_Text(RPi,'Lindenberg 66',13);
  620.    Move(RPi,239,200);gfx:=_Text(RPi,'98693 Ilmenau/Thür.',19);
  621.    SetAPen(RPi,1);Move(RPi,35,216);gfx:=_Text(RPi,
  622.    'Programmhinweis: Will man die Tastenkombinationen (z.B. für ENDE)',65);
  623.    Move(RPi,35,224);gfx:=_Text(RPi,
  624.    'benutzen, wenn ein Stringgadget aktiviert ist, vorher erst über',63);
  625.    Move(RPi,35,232);gfx:=_Text(RPi,
  626.    'rechte Alt-/ rechte Amiga-Taste deaktivieren, Have Fun PackMAN...',65);
  627.    x:=false;
  628.   REPEAT
  629.     GADiMsg:=Wait_Port(wi^.UserPort);
  630.     GADiMsg:=Get_Msg(wi^.UserPort);
  631.     case GADiMsg^.Class of
  632.      GADGETUP: x:=true;
  633.      RAWKEY:
  634.       if GADiMsg^.code in [$45,$12,$44] then x:=true;
  635.     else; end; {of case}
  636.    Reply_Msg(GADiMsg);
  637.  UNTIL x=true;
  638.  message('Information gelesen');
  639.  Close_Window(wi);
  640. END;
  641.  
  642.  
  643. {------------------------------------------------------------------------}
  644.  
  645. PROCEDURE Setfarbe(Nr,R,G,B:byte);
  646.  
  647. BEGIN
  648.  setRGB4(^Scr^.ViewPort,Nr,R,G,B);
  649. END;
  650.  
  651.  
  652.  
  653. {------------------------------------------------------------------------}
  654.  
  655. PROCEDURE Prefs;
  656.  
  657. TYPE  Feld=array[1..15] of Gadget;
  658.       TxFeld=array[1..3] of IntuiText;
  659.       pimagefeld=array[1..3] of image;
  660.       Proinfofeld=array[5..7] of Propinfo;
  661.       zfeld=array[5..7] of byte;
  662.       Vorfeld=array[5..7] of boolean;
  663.  
  664. VAR    x,NLQ,auto:boolean;STATIC;
  665.        wp:^window;STATIC;
  666.        PMsg:^IntuiMessage;STATIC;
  667.        Gp:Feld;STATIC;
  668.        Gtp:TxFeld;STATIC;
  669.        RPp:^RastPort;STATIC;
  670.        pimage: pimagefeld;STATIC;
  671.        Gpi:Proinfofeld;STATIC;
  672.        a,b,c,d,zahl:zfeld;STATIC;
  673.        FarbNr,ProGadID:byte;STATIC;
  674.        zeigauf:^Gadget;STATIC;
  675.        leerZ,help1,help2:integer;STATIC;
  676.        Gpi13:StringInfo;STATIC;
  677.        Gpt13:string[4];STATIC;
  678.  
  679. {*-----------------------------------------------------------------------}
  680.  
  681. PROCEDURE Farbnrausgabe(x,y:cardinal; laber:Str);
  682.  
  683. VAR itx:IntuiText;
  684.  
  685. BEGIN
  686.  itx:=IntuiText(3,0,1,x,y,NIL,laber,NIL);
  687.  PrintIText(wp^.RPort,^itx,0,0);
  688. END;
  689.  
  690. {*-----------------------------------------------------------------------}
  691.  
  692. PROCEDURE PosPRO(z,pos:byte);
  693.  
  694. VAR zahlstr:string[3];
  695.  
  696. BEGIN
  697.  with Gpi[z] do
  698.   BEGIN
  699.    zahl[z]:=Round(VertPot/Vertbody);
  700.    if zahl[z]<10
  701.     then
  702.      zahlstr:='0'+IntSTR(zahl[z])
  703.     else
  704.      zahlstr:=IntSTR(zahl[z]);
  705.      Setfarbe(Farbnr,zahl[5],zahl[6],zahl[7]);
  706.      case farbnr of
  707.       0: a[z]:=zahl[z];
  708.       1: b[z]:=zahl[z];
  709.       2: c[z]:=zahl[z];
  710.       3: d[z]:=zahl[z];
  711.      else; END;
  712.      Farbnrausgabe(pos,105,zahlstr);
  713.   END;
  714. END;
  715.  
  716. {*------------------------------------------------------------------------}
  717.  
  718. PROCEDURE Propbalkensetzen;
  719.  
  720. BEGIN
  721.    with Gpi[5] do  Vertpot:=zahl[5]*Vertbody ;
  722.    with Gpi[6] do  Vertpot:=zahl[6]*Vertbody ;
  723.    with Gpi[7] do  Vertpot:=zahl[7]*Vertbody ;
  724.    PosPRO(5,22);
  725.    PosPRO(6,55);
  726.    PosPRO(7,88);
  727.    REFRESHGADGETS(^Gp[5],wp,nil);
  728.    REFRESHGADGETS(^Gp[6],wp,nil);
  729.    REFRESHGADGETS(^Gp[7],wp,nil);
  730. END;
  731. {*-----------------------------------------------------------------------}
  732.  
  733. PROCEDURE Inccolor(x,y:byte);
  734.  
  735.  PROCEDURE Propb;
  736.   BEGIN
  737.    with Gpi[x] do  Vertpot:=zahl[x]*Vertbody ;
  738.    PosPRO(x,y);
  739.    REFRESHGADGETS(^Gp[x],wp,nil);
  740.   END;
  741.  
  742. BEGIN
  743.  if zahl[x]<15
  744.   then BEGIN
  745.         INC(zahl[x]);
  746.         Propb;
  747.        END
  748.   else BEGIN zahl[x]:=0;Propb; END;
  749. END;
  750.  
  751. {*------------------------------------------------------------------------}
  752.  
  753. PROCEDURE benutzen;
  754.  
  755. BEGIN
  756.  ah[5]:=a[5];ah[6]:=a[6];ah[7]:=a[7];
  757.  bh[5]:=b[5];bh[6]:=b[6];bh[7]:=b[7];
  758.  ch[5]:=c[5];ch[6]:=c[6];ch[7]:=c[7];
  759.  dh[5]:=d[5];dh[6]:=d[6];dh[7]:=d[7];
  760.  NLQu:=NLQ;
  761.  autoh:=auto;
  762.  leerZh:=leerZ;
  763. END;
  764.  
  765. {*------------------------------------------------------------------------}
  766. PROCEDURE savecon;
  767. VAR f:text;STATIC;
  768. BEGIN
  769.  rewrite(f,'SYS:S/AprintV1.1.config');
  770.  if IOResult=0 then
  771.   BEGIN writeln(f,Kenn);
  772.         for i:=5 to 7 do writeln(f,ah[i]);
  773.         for i:=5 to 7 do writeln(f,bh[i]);
  774.         for i:=5 to 7 do writeln(f,ch[i]);
  775.         for i:=5 to 7 do writeln(f,dh[i]);
  776.         if NLQu  then writeln(f,'1') else writeln(f,'0');
  777.         if autoh then writeln(f,'1') else writeln(f,'0');
  778.         writeln(f,rufname); {for autoload}
  779.         writeln(f,pfad);    {zum merken des Drawers}
  780.         writeln(f,datei);
  781.         writeln(f,leerZh);
  782.         message('Konfiguration gespeichert.');
  783.         close(f);
  784.    END
  785.  else  message('Konnte Konfiguration nicht speichern.');
  786. END;
  787.  
  788. {*------------------------------------------------------------------------}
  789. PROCEDURE back;
  790.  
  791. BEGIN
  792.  Setfarbe(0,ah[5],ah[6],ah[7]);
  793.  Setfarbe(1,bh[5],bh[6],bh[7]);
  794.  Setfarbe(2,ch[5],ch[6],ch[7]);
  795.  Setfarbe(3,dh[5],dh[6],dh[7]);
  796. END;
  797.  
  798. {*------------------------------------------------------------------------}
  799. PROCEDURE vorw;
  800.   BEGIN if leerZ<40 then
  801.           BEGIN INC(leerZ); Gpt13:=INTSTR(leerZ);
  802.                 REFRESHGADGETS(^Gp[13],Wp,nil);
  803.           END
  804.          else
  805.           BEGIN REFRESHGADGETS(^Gp[12],Wp,nil);
  806.            message('Es geht eben nicht weiter nach rechts.');
  807.           END;
  808.   END;
  809.  
  810. {*------------------------------------------------------------------------}
  811. PROCEDURE rueckw;
  812.   BEGIN if leerZ>0 then
  813.           BEGIN DEC(leerZ); Gpt13:=INTSTR(leerZ);
  814.                 REFRESHGADGETS(^Gp[13],Wp,nil);
  815.           END
  816.          else
  817.           BEGIN REFRESHGADGETS(^Gp[12],Wp,nil);
  818.                 message('Es geht eben nicht weiter nach links.');
  819.           END;
  820.   END;
  821.  
  822. {-----------------------------Prefs---------------------------------------}
  823.  
  824.  BEGIN
  825.   wp:=Open_Window(100,60,440,146,1,GADGETUP+GADGETDOWN+RAWKEY+MOUSEMOVE,
  826.                   RMBTRAP+BORDERLESS+ACTIVATE,NIL,Scr,440,146,440,146);
  827.    GRand(wp,0,0,438,144);
  828.    RPp:=wp^.RPort;
  829.  
  830.    Gtp[1]:=IntuiText(1,0,0,14,5,nil,'Speichern',nil);
  831.    Gtp[2]:=IntuiText(1,0,0,18,5,nil,'Benutzen',nil);
  832.    Gtp[3]:=IntuiText(1,0,0,22,5,nil,'Abbruch',nil);
  833.  
  834.     for i:=1 to 3 do
  835.      BEGIN
  836.         Gp[i]:=Gadget(^Gp[1+i],(130*i-90),120,102,17,GADGHCOMP,RELVERIFY+
  837.                  GADGIMMEDIATE,BOOLGADGET,NIL,NIL,^Gtp[i],0,NIL,i,NIL);
  838.         GRand(Wp,(130*i-90),120,101,16);    {Speichern...Abbruch}
  839.      END;
  840.  
  841.     Gp[5]:=GADGET(^Gp[6],20,15,20,85,GADGHNONE+GADGIMAGE,GADGIMMEDIATE+
  842.                 RELVERIFY+FOLLOWMOUSE,PROPGADGET,^pimage[1],NIL,
  843.                 NIL,0,^Gpi[5],5,NIL);
  844.     Gpi[5]:=Propinfo(AUTOKNOB+FREEVERT+PROPBORDERLESS,0,0,0,$ffff div 15,
  845.                    0,0,0,0,0,0);
  846.  
  847.     Gp[6]:=GADGET(^Gp[7],53,15,20,85,GADGHCOMP+GADGIMAGE,GADGIMMEDIATE+
  848.                 RELVERIFY+FOLLOWMOUSE,PROPGADGET,^pimage[2],NIL,
  849.                 NIL,0,^Gpi[6],6,NIL);
  850.     Gpi[6]:=Propinfo(AUTOKNOB+FREEVERT+PROPBORDERLESS,0,0,0,$ffff div 15,
  851.                    0,0,0,0,0,0);
  852.  
  853.     Gp[7]:=GADGET(^Gp[8],86,15,20,85,GADGHCOMP+GADGIMAGE,GADGIMMEDIATE+
  854.                 RELVERIFY+FOLLOWMOUSE,PROPGADGET,^pimage[3],NIL,
  855.                 NIL,0,^Gpi[7],7,NIL);
  856.     Gpi[7]:=Propinfo(AUTOKNOB+FREEVERT+PROPBORDERLESS,0,0,0,$ffff div 15,
  857.                    0,0,0,0,0,0);
  858.     GRand(wp,19,14,22,86);
  859.     GRand(wp,52,14,22,86);        {Propgads}
  860.     GRand(wp,85,14,22,86);
  861.  
  862.     GRand(Wp, 150,14,40,20);
  863.  
  864.    Gp[8]:=Gadget(^Gp[9],127,56,37,19,GADGHBOX,RELVERIFY+
  865.                  GADGIMMEDIATE,BOOLGADGET,NIL,NIL,NIL,0,NIL,8,NIL);
  866.    GRand(Wp, 125,55,40,20);                       {0}
  867.    SetAPen(RPp,1);
  868.    Move(RPp,141,68); gfx:=_Text(RPp,'1',1);
  869.  
  870.    Gp[9]:=Gadget(^Gp[10],127,81,37,19,GADGHBOX,RELVERIFY+
  871.                  GADGIMMEDIATE,BOOLGADGET,NIL,NIL,NIL,0,NIL,9,NIL);
  872.    GRand(Wp, 125,80,40,20);
  873.    SetAPen(RPp,1);RectFill(RPp,126,81,163,99);
  874.    SetAPen(RPp,0); SetBPen(RPp,1);                {1}
  875.    Move(RPp,141,93); gfx:=_Text(RPp,'2',1);
  876.  
  877.    Gp[10]:=Gadget(^Gp[11],177,56,37,19,GADGHBOX,RELVERIFY+
  878.                  GADGIMMEDIATE,BOOLGADGET,NIL,NIL,NIL,0,NIL,10,NIL);
  879.    GRand(Wp, 175,55,40,20);
  880.    SetAPen(RPp,2);RectFill(RPp,176,56,213,74);
  881.    SetAPen(RPp,3);SetBPen(RPp,2);                 {2}
  882.    Move(RPp,191,68); gfx:=_Text(RPp,'3',1);
  883.  
  884.    Gp[11]:=Gadget(^Gp[12],177,81,37,19,GADGHBOX,RELVERIFY+
  885.                  GADGIMMEDIATE,BOOLGADGET,NIL,NIL,NIL,0,NIL,11,NIL);
  886.    GRand(Wp, 175,80,40,20);
  887.    SetAPen(RPp,3);RectFill(RPp,176,81,213,99);
  888.    SetAPen(RPp,2);SetBPen(RPp,3);                 {3}
  889.    Move(RPp,191,93); gfx:=_Text(RPp,'4',1);
  890.    SetBPen(RPp,0);
  891.  
  892.    NLQ:=NLQu;
  893.    Gp[4]:=GADGET(^Gp[5],307,20,17,9,GADGHIMAGE+GADGIMAGE,RELVERIFY+TOGGLESELECT,
  894.                 BOOLGADGET,^radio1,^radio2,NIL,0,NIL,4,NIL); {NLQ}
  895.    if NLQ then Gp[4].flags:=(GADGHIMAGE+GADGIMAGE+SELECTED);
  896.  
  897.    auto:=autoh;
  898.    Gp[12]:=GADGET(^Gp[13],307,40,17,9,GADGHIMAGE+GADGIMAGE,RELVERIFY+TOGGLESELECT,
  899.                 BOOLGADGET,^radio1,^radio2,NIL,0,NIL,12,NIL); {AutoLoad}
  900.    if auto then Gp[12].flags:=(GADGHIMAGE+GADGIMAGE+SELECTED);
  901.  
  902.     leerZ:=leerZh;
  903.     Gpt13:=INTSTR(leerZ);
  904.     Gp[13]:=GADGET(^Gp[14],339,90,24,12,GADGHCOMP,RELVERIFY+_LONGINT,
  905.                     STRGADGET,NIL,NIL,NIL,0,^Gpi13,13,NIL);
  906.     Gpi13:=Stringinfo(^Gpt13,nil,0,3,0,0,0,0,0,0,nil,0,nil);
  907.    SRand(Wp, 334,86,35,14);
  908.  
  909.    SetAPen(RPp,1);
  910.    Move(RPp,54,133);  Draw(RPp,62,133);     {Speichern}
  911.    Move(RPp,228,133); Draw(RPp,236,133);    {Benutzen}
  912.    Move(RPp,322,133); Draw(RPp,330,133);    {Abbruch}
  913.  
  914.    Gp[14]:=Gadget(^Gp[15],301,86,29,15,GADGHCOMP,RELVERIFY+
  915.                  GADGIMMEDIATE,BOOLGADGET,NIL,NIL,NIL,0,NIL,14,NIL);
  916.    GRand(Wp, 301,86,28,14);
  917.    SetAPen(RPp,3);
  918.    Move(RPp,310,96); gfx:=_Text(RPp,'+',1);
  919.  
  920.    Gp[15]:=Gadget(NIL,375,86,29,15,GADGHCOMP,RELVERIFY+
  921.                  GADGIMMEDIATE,BOOLGADGET,NIL,NIL,NIL,0,NIL,15,NIL);
  922.    GRand(Wp,375,86,28,14);
  923.    Move(RPp,385,96); gfx:=_Text(RPp,'-',1);
  924.  
  925.    SetAPen(RPp,3);
  926.    Move(RPp,26,10); gfx:=_Text(RPp,'R',1);
  927.    Move(RPp,59,10); gfx:=_Text(RPp,'G',1);
  928.    Move(RPp,92,10); gfx:=_Text(RPp,'B',1);
  929.    Move(RPp,26,12); Draw(RPp,34,12);
  930.    Move(RPp,59,12); Draw(RPp,67,12);
  931.    Move(RPp,92,12); Draw(RPp,100,12);
  932.  
  933.    Move(RPp,337,29); Draw(RPp,345,29);    {NLQ}
  934.    Move(RPp,337,27);
  935.    gfx:=_Text(RPp,'NLQ',3);
  936.  
  937.    Move(RPp,377,49); Draw(RPp,385,49);    {Autoload}
  938.    Move(RPp,337,47);
  939.    gfx:=_Text(RPp,'AutoLoad',8);
  940.  
  941.    Move(RPp,308,79);
  942.    gfx:=_Text(RPp,'Leerzeichen',11);
  943.    Move(RPp,308,81);  Draw(RPp,316,81);
  944.  
  945.    a[5]:=ah[5];a[6]:=ah[6];a[7]:=ah[7];
  946.    b[5]:=bh[5];b[6]:=bh[6];b[7]:=bh[7];
  947.    c[5]:=ch[5];c[6]:=ch[6];c[7]:=ch[7];
  948.    d[5]:=dh[5];d[6]:=dh[6];d[7]:=dh[7];
  949.    zahl[7]:=ah[7];
  950.    zahl[5]:=ah[5];
  951.    zahl[6]:=ah[6];
  952.    FarbNr:=0;
  953.    wp^.firstgadget:=^Gp[1];
  954.    REFRESHGADGETS(wp^.Firstgadget,wp,nil);
  955.    Propbalkensetzen;
  956.    x:=false;
  957.   REPEAT
  958.     PMsg:=Get_Msg(wp^.UserPort);
  959.     if PMsg<>nil then
  960.      BEGIN
  961.       Akt:=PMsg^.IAddress;
  962.       Reply_Msg(PMsg);
  963.       case PMsg^.Class of
  964.       GADGETUP:
  965.         case Akt^.GadgetID of
  966. {Sp}       1: BEGIN benutzen; savecon; x:=true;END;
  967. {Be}       2: BEGIN benutzen; x:=true;
  968.                     message('Benutze Voreinstellungen.');END;
  969. {Ab}       3: BEGIN back;x:=true;message('Prefs abgebrochen.');END;
  970.            5: PosPRO(5,22);
  971.            6: PosPRO(6,55);
  972.            7: PosPRO(7,88);
  973. {NLQ}      4: if (Gp[4].flags and SELECTED)<>0
  974.                then
  975.                  NLQ:=true
  976.                 else
  977.                  NLQ:=false;
  978.            8: BEGIN
  979.                zahl[5]:=a[5];zahl[6]:=a[6];zahl[7]:=a[7];
  980.                SetAPen(RPp,0);RectFill(RPp,151,15,188,33);
  981.                FarbNr:=0;
  982.                Propbalkensetzen;
  983.               END;
  984.            9: BEGIN
  985.                zahl[5]:=b[5];zahl[6]:=b[6];zahl[7]:=b[7];
  986.                SetAPen(RPp,1);RectFill(RPp,151,15,188,33);
  987.                FarbNr:=1;
  988.                Propbalkensetzen;
  989.               END;
  990.           10: BEGIN
  991.                zahl[5]:=c[5];zahl[6]:=c[6];zahl[7]:=c[7];
  992.                SetAPen(RPp,2);RectFill(RPp,151,15,188,33);
  993.                FarbNr:=2;
  994.                Propbalkensetzen;
  995.               END;
  996.           11: BEGIN
  997.                zahl[5]:=d[5];zahl[6]:=d[6];zahl[7]:=d[7];
  998.                SetAPen(RPp,3);RectFill(RPp,151,15,188,33);
  999.                FarbNr:=3;
  1000.                Propbalkensetzen;
  1001.               END;
  1002.           12: if (Gp[12].flags and SELECTED)<>0
  1003.                then
  1004.                  auto:=true
  1005.                 else
  1006.                  auto:=false;
  1007.           13: BEGIN VAL(Gpt13,help1,help2);
  1008.                     if (help2=0) and (help1<41) then leerZ:=help1
  1009.                       else BEGIN Gpt13:=INTSTR(leerZ);
  1010.                                  REFRESHGADGETS(^Gp[13],Wp,nil);
  1011.                                  message('Sinnlose Einstellung, danke !?!');
  1012.                            END;
  1013.               END;
  1014.           14: vorw;
  1015.           15: rueckw;
  1016.          else; end;
  1017.  
  1018.      MOUSEMOVE:
  1019.        BEGIN
  1020.          if ProGadID=5 then PosPRO(5,22);
  1021.          if ProGadID=6 then PosPRO(6,55);
  1022.          if ProGadID=7 then PosPRO(7,88);
  1023.        END;
  1024.  
  1025.     GADGETDOWN:
  1026.        BEGIN
  1027.         zeigauf:=PMsg^.IAddress;
  1028.         ProGadID:=zeigauf^.GadgetID; {nervend für Mousemove}
  1029.        END;
  1030.  
  1031.      RAWKEY:
  1032.       case PMsg^.code of
  1033.          $01: BEGIN
  1034.                zahl[5]:=a[5];zahl[6]:=a[6];zahl[7]:=a[7];
  1035.                SetAPen(RPp,0);RectFill(RPp,151,15,188,33);
  1036.                FarbNr:=0;
  1037.                Propbalkensetzen;
  1038.               END;
  1039.          $02: BEGIN
  1040.                zahl[5]:=b[5];zahl[6]:=b[6];zahl[7]:=b[7];
  1041.                SetAPen(RPp,1);RectFill(RPp,151,15,188,33);
  1042.                FarbNr:=1;
  1043.                Propbalkensetzen;
  1044.               END;
  1045.          $03: BEGIN
  1046.                zahl[5]:=c[5];zahl[6]:=c[6];zahl[7]:=c[7];
  1047.                SetAPen(RPp,2);RectFill(RPp,151,15,188,33);
  1048.                FarbNr:=2;
  1049.                Propbalkensetzen;
  1050.               END;
  1051.          $04: BEGIN
  1052.                zahl[5]:=d[5];zahl[6]:=d[6];zahl[7]:=d[7];
  1053.                SetAPen(RPp,3);RectFill(RPp,151,15,188,33);
  1054.                FarbNr:=3;
  1055.                Propbalkensetzen;
  1056.               END;
  1057.        $45,$12,$20:BEGIN back; x:=true;
  1058.                    message('Prefs abgebrochen.');END; {Abbruch:ESC/E/A}
  1059.        $15: BEGIN benutzen; x:=true;
  1060.             message('Benutze Voreinstellungen.');END; {Benutzen: z}
  1061.        $18: BEGIN                                     {Autoload: O}
  1062.               if (Gp[12].flags and SELECTED)=0
  1063.                then
  1064.                 BEGIN
  1065.                  Gp[12].flags:=(GADGHIMAGE+GADGIMAGE+SELECTED);
  1066.                  auto:=true;
  1067.                 END
  1068.                 else
  1069.                  BEGIN
  1070.                  Gp[12].flags:=(GADGHIMAGE+GADGIMAGE);
  1071.                  auto:=false;
  1072.                 END;
  1073.                REFRESHGADGETS(^Gp[12],Wp,nil);
  1074.              END;
  1075.        $21: BEGIN benutzen; savecon; x:=true;END;{Speichern: S}
  1076.        $13: Inccolor(5,22);                      {R}
  1077.        $24: Inccolor(6,55);                      {G}
  1078.        $35: Inccolor(7,88);                      {B}
  1079.        $36: BEGIN
  1080.               if (Gp[4].flags and SELECTED)=0
  1081.                then
  1082.                 BEGIN
  1083.                  Gp[4].flags:=(GADGHIMAGE+GADGIMAGE+SELECTED);
  1084.                  NLQ:=true;
  1085.                 END                                 {NLQ:        N}
  1086.                 else
  1087.                  BEGIN
  1088.                  Gp[4].flags:=(GADGHIMAGE+GADGIMAGE);
  1089.                  NLQ:=false;
  1090.                 END;
  1091.                REFRESHGADGETS(^Gp[4],Wp,nil);
  1092.              END;
  1093.        $1b: vorw;    {+}
  1094.        $3a: rueckw;  {-}
  1095.        $28: BEGIN
  1096.               strw:=ActivateGadget(^Gp[13],wp,Nil);
  1097.               VAL(Gpt13,help1,help2);
  1098.                if (help2=0) and (help1<41) then leerZ:=help1
  1099.                  else BEGIN Gpt13:=INTSTR(leerZ);
  1100.                             REFRESHGADGETS(^Gp[13],Wp,nil);
  1101.                             message('Sinnlose Einstellung, danke !?!');
  1102.                       END;
  1103.            END;
  1104.       else;end;
  1105.     else; end; {of case}
  1106.    END
  1107.   else
  1108.    BEGIN
  1109.     Msg:=Get_Msg(Win^.UserPort);
  1110.     if Msg<>nil
  1111.      then Reply_Msg(Msg);
  1112.    END;
  1113.  UNTIL x=true;
  1114.  Close_Window(wp);
  1115. END;
  1116.  
  1117. {------------------------------------------------------------------------}
  1118.  
  1119. procedure HauptWin;
  1120.  
  1121.   BEGIN
  1122.  
  1123.     PFEILIMAGE;
  1124.     Radio;
  1125.  
  1126.     Scr:=Open_Screen(0,0,640,256,2,2,1,HIRES+GENLOCK_VIDEO,
  1127.          'APrint V1.1 © & P by Falk Zühlsdorff 01.01.94 Homeversion');
  1128.     Vp:=Scr^.ViewPort;
  1129.     Setfarbe(0,ah[5],ah[6],ah[7]);
  1130.     Setfarbe(1,bh[5],bh[6],bh[7]);
  1131.     Setfarbe(2,ch[5],ch[6],ch[7]);
  1132.     Setfarbe(3,dh[5],dh[6],dh[7]);
  1133.  
  1134.     Win:=Open_Window(0,10,640,246,1,RAWKEY+GADGETUP,ACTIVATE+
  1135.                      BORDERLESS+RMBTRAP+BACKDROP,Nil,Scr,640,246,640,246);
  1136.     RP:=Win^.RPort;
  1137.  
  1138.     PrcH:=FindTask(Nil);
  1139.     Prc:=PrcH;                   {Fehlerreq./Task auf eigenen Screen}
  1140.     OWin:=Prc^.pr_WindowPtr;              {umleiten}
  1141.     Prc^.pr_WindowPtr:=Win;
  1142.     GRand(Win,0,1,638,244);      {Fenster 3D-Rand}
  1143.  
  1144.     for i:=0 to 4 do
  1145.      BEGIN
  1146.       S2[i]:='    frei    ';
  1147.       G[i]:=Gadget(^G[i+1],14,(19*i+9),102,17,GADGHCOMP,RELVERIFY+
  1148.                   GADGIMMEDIATE,BOOLGADGET,NIL,NIL,^Gt[i],0,NIL,i,NIL);
  1149.       Gt[i]:=IntuiText(1,0,1,3,5,nil,^S2[i],nil);
  1150.       GRand(Win,14,(19*i+9),101,16);
  1151.      END;
  1152.     for i:=5 to 9 do
  1153.      BEGIN
  1154.       S2[i]:='    frei    ';
  1155.       G[i]:=Gadget(^G[i+1],14,(19*i+43),102,17,GADGHCOMP,RELVERIFY+
  1156.                   GADGIMMEDIATE,BOOLGADGET,NIL,NIL,^Gt[i],0,NIL,i,NIL);
  1157.       Gt[i]:=IntuiText(1,0,1,3,5,nil,^S2[i],nil);
  1158.       GRand(Win,14,(19*i+43),101,16);
  1159.      END;
  1160.      G[10]:=Gadget(^G[11],45,112,43,17,GADGHCOMP,RELVERIFY+
  1161.                   GADGIMMEDIATE,BOOLGADGET,NIL,NIL,NIL,0,NIL,10,NIL);
  1162.      DrawImage(RP,^ipf,57,115);
  1163.      GRand(Win,45,112,42,16);
  1164.  
  1165.      SetAPen(RP,1);
  1166.      Move(RP,130,235);
  1167.      Draw(RP,130,5);
  1168.  
  1169.      for i:=0 to 3 do
  1170.       BEGIN
  1171.        SGt[i]:='';
  1172.        SG[i]:=GADGET(^SG[i+1],216,(19*i+14),248,12,GADGHCOMP,RELVERIFY,
  1173.                      STRGADGET,NIL,NIL,NIL,0,^SGi[i],11+i,NIL);
  1174.        SGi[i]:=Stringinfo(^SGt[i],nil,0,31,0,0,0,0,0,0,nil,0,nil);
  1175.        SRand(Win,212,(19*i+10),254,14);   {name1... PLZ}
  1176.       END;
  1177.  
  1178.      SGt[4]:='';
  1179.      SG[4]:=GADGET(^SG[5],216,90,88,12,GADGHCOMP,RELVERIFY,
  1180.                     STRGADGET,NIL,NIL,NIL,0,^SGi[4],15,NIL);
  1181.      SGi[4]:=Stringinfo(^SGt[4],nil,0,11,0,0,0,0,0,0,nil,0,nil);
  1182.      SRand(Win,212,86,96,14);       {Kürzel}
  1183.  
  1184.      Move(RP,135,107);
  1185.      Draw(RP,635,107);
  1186.  
  1187.      SGt[5]:='';
  1188.      SG[5]:=GADGET(^SG[6],216,117,408,12,GADGHCOMP,RELVERIFY,
  1189.                     STRGADGET,NIL,NIL,NIL,0,^SGi[5],16,NIL);
  1190.      SGi[5]:=Stringinfo(^SGt[5],nil,0,51,0,0,0,0,0,0,nil,0,nil);
  1191.      SRand(Win,212,113,414,14);       {Abs}
  1192.      Move(RP,135,133);
  1193.      Draw(RP,635,133);
  1194.  
  1195.                       {##### GfxTx #####}
  1196.      SetAPen(RP,3);
  1197.      Move(RP,138,20);
  1198.      gfx:=_Text(RP,'1.Name:',7);
  1199.  
  1200.      Move(RP,138,39);
  1201.      gfx:=_Text(RP,'2.Name:',7);
  1202.  
  1203.      Move(RP,138,58);
  1204.      gfx:=_Text(RP,'Straße:',7);
  1205.  
  1206.      Move(RP,138,77);
  1207.      gfx:=_Text(RP,'PLZ/Ort:',8);
  1208.  
  1209.      Move(RP,138,96);
  1210.      gfx:=_Text(RP,'Kürzel:',7);
  1211.  
  1212.      Move(RP,138,123);
  1213.      gfx:=_Text(RP,'Abs.:',5);
  1214.  
  1215.      Move(RP,138,226);
  1216.      gfx:=_Text(RP,'Kommentar',9);
  1217.  
  1218.  
  1219.  
  1220.                {######### Tastenkombies-Kennungen ##########}
  1221.  
  1222.      SetAPen(RP,3);
  1223.      Move(RP,162,22);  Draw(RP,170,22);     {1.Name}
  1224.      Move(RP,170,41);  Draw(RP,178,41);     {2.Name}
  1225.      Move(RP,170,60);  Draw(RP,178,60);     {Straße}
  1226.      Move(RP,170,79);  Draw(RP,178,79);     {PLZ/Ort}
  1227.      Move(RP,138,98);  Draw(RP,146,98);     {Kürzel}
  1228.      Move(RP,146,125); Draw(RP,154,125);    {Abs.}
  1229.      SetAPen(RP,2);
  1230.      Move(RP,537,52);  Draw(RP,545,52);     {Sleep/Shell}
  1231.      SetAPen(RP,3);
  1232.      Move(RP,320,170); Draw(RP,328,170);    {Neu}
  1233.      Move(RP,421,170); Draw(RP,429,170);    {Laden}
  1234.      Move(RP,531,170); Draw(RP,539,170);    {Prefs}
  1235.  
  1236.  
  1237.      Move(RP,202,170);  Draw(RP,210,170);   {Loeschen}
  1238.      Move(RP,205,189);  Draw(RP,213,189);   {Info}
  1239.      Move(RP,295,189);  Draw(RP,303,189);   {Speichern}
  1240.      Move(RP,413,189);  Draw(RP,421,189);   {Drucken}
  1241.      Move(RP,535,189);  Draw(RP,543,189);   {Ende}
  1242.  
  1243.                         {++++ un veidar gädz +++}
  1244.  
  1245.      Gt[11]:=IntuiText(3,0,0,34,5,nil,'Info',nil);
  1246.      Gt[12]:=IntuiText(3,0,0,14,5,nil,'Speichern',nil);
  1247.      Gt[13]:=IntuiText(3,0,0,22,5,nil,'Drucken',nil);
  1248.      Gt[14]:=IntuiText(3,0,0,34,5,nil,'Ende',nil);
  1249.      for i:=0 to 3 do
  1250.       BEGIN
  1251.        G[11+i]:=Gadget(^G[12+i],(110*i+171),176,102,17,GADGHCOMP,RELVERIFY+
  1252.                 GADGIMMEDIATE,BOOLGADGET,NIL,NIL,^Gt[11+i],0,NIL,17+i,NIL);
  1253.        GRand(Win,(110*i+171),176,101,16);    {Info....Ende}
  1254.       END;
  1255.       Gt[16]:=IntuiText(3,0,0,23,5,nil,'Löschen',nil);
  1256.       Gt[17]:=IntuiText(3,0,0,39,5,nil,'Neu',nil);
  1257.       Gt[18]:=IntuiText(3,0,0,30,5,nil,'Laden',nil);
  1258.       Gt[19]:=IntuiText(3,0,0,30,5,nil,'Prefs',nil);
  1259.  
  1260.       for i:=0 to 2 do
  1261.        BEGIN
  1262.         G[16+i]:=Gadget(^G[17+i],(110*i+171),157,102,17,GADGHCOMP,RELVERIFY+
  1263.                  GADGIMMEDIATE,BOOLGADGET,NIL,NIL,^Gt[16+i],0,NIL,23+i,NIL);
  1264.         GRand(Win,(110*i+171),157,101,16);    {Löschen...Prefs}
  1265.        END;
  1266.        G[19]:=Gadget(^SG[0],501,157,102,17,GADGHCOMP,RELVERIFY+
  1267.                  GADGIMMEDIATE,BOOLGADGET,NIL,NIL,^Gt[19],0,NIL,26,NIL);
  1268.        GRand(Win,501,157,101,16);
  1269.  
  1270.       Gt[15]:=IntuiText(2,0,0,5,5,nil,'Shell',nil);
  1271.       G[15]:=Gadget(^G[16],524,39,52,17,GADGHCOMP,RELVERIFY+
  1272.              GADGIMMEDIATE,BOOLGADGET,NIL,NIL,^Gt[15],0,NIL,21,NIL);
  1273.       GRand(Win,524,39,51,16);               {Shell ???}
  1274.  
  1275.       SetAPen(RP,1);
  1276.       Move(RP,135,204);
  1277.       Draw(RP,635,204);
  1278.       if not fehl then
  1279.         SGt[6]:='Willkommen zu APrint, PackMAN'
  1280.        else SGt[6]:='Konnte Konfiguration nicht laden.';
  1281.       SG[6]:=GADGET(NIL,216,220,408,12,GADGHCOMP,RELVERIFY+STRINGCENTER,
  1282.                     STRGADGET,NIL,NIL,NIL,0,^SGi[6],22,NIL);
  1283.       SGi[6]:=Stringinfo(^SGt[6],nil,0,51,0,0,0,0,0,0,nil,0,nil);
  1284.       SRand(Win,212,216,414,14);             {Kommentar}
  1285.  END;
  1286.  
  1287. {--------------------------------------------------------------------}
  1288.  
  1289. PROCEDURE UniWin(x,y,rueber1,runter1,rueber2,runter2,ux1,uy1,ux2,uy2:integer;
  1290.                  TxG1,TxG2,Tx1:String;b1:byte);
  1291.  
  1292. TYPE TxType=array[0..2] of IntuiText;
  1293.  
  1294. VAR UMsg:^IntuiMessage;
  1295.     WUni:^window;
  1296.     G1,G2:Gadget;STATIC;
  1297.     ITx:TxType;
  1298.     ende:boolean;
  1299.     RPu:^RASTPORT;
  1300. BEGIN
  1301.  ITx:=TxType
  1302.   (IntuiText(3,0,1,0,0,nil,^Tx1,nil),
  1303.    IntuiText(1,0,1,rueber1,runter1,nil,^TxG1,nil),
  1304.    IntuiText(1,0,1,rueber2,runter1,nil,^TxG2,nil));
  1305.    WUni:=Open_Window(x,y,185,35,1,GADGETUP+RAWKEY,ACTIVATE+RMBTRAP+BORDERLESS,
  1306.                      NIL,Scr,185,35,185,35);
  1307.    GRand(WUni,0,0,184,34);
  1308.    GRand(WUni,6,5,82,16);
  1309.    G1:=Gadget(^G2,6,5,83,17,GADGHCOMP,RELVERIFY+GADGIMMEDIATE,
  1310.        BOOLGADGET,NIL,NIL,^ITx[1],0,NIL,1,NIL);
  1311.    GRand(WUni,96,5,82,16);
  1312.    G2:=Gadget(Nil,96,5,83,17,GADGHCOMP,RELVERIFY+GADGIMMEDIATE,
  1313.           BOOLGADGET,NIL,NIL,^ITx[2],0,NIL,2,NIL);
  1314.    WUni^.FIRSTGADGET:=^G1;
  1315.    REFRESHGADGETS(WUni^.FIRSTGADGET,WUni,nil);
  1316.    RPu:=WUni^.RPort;
  1317.    SetAPen(RPu,1);
  1318.    Move(RPu,ux1,uy2+8);
  1319.    Draw(RPu,ux1+8,uy2+8);    {lGad}
  1320.    Move(RPu,ux2+90,uy2+8);
  1321.    Draw(RPu,ux2+98,uy2+8);   {rGad}
  1322.  
  1323.    PrintIText(WUni^.RPort,^ITx,12,25);
  1324.    REPEAT
  1325.    ende:=false;
  1326.    UMsg:=Wait_Port(WUni^.UserPort);
  1327.    UMsg:=Get_Msg(WUni^.UserPort);
  1328.     case UMsg^.Class of
  1329.      GADGETUP:
  1330.       BEGIN
  1331.        AKT:=UMsg^.IAddress;
  1332.        case AKT^.GADGETID of
  1333.        1: BEGIN ergebnis:=true;  ende:=true; END;
  1334.        2: BEGIN ergebnis:=false; ende:=true; END;
  1335.        else; end; {of case inneres}
  1336.       END;
  1337.      RAWKEY:
  1338.       if b1=1 then
  1339.        BEGIN
  1340.         case UMsg^.code of
  1341.          $44,$12: BEGIN ergebnis:=true; ende:=true; END;
  1342.          $45,$15: BEGIN ergebnis:=false;ende:=true; END;
  1343.         else; end;
  1344.        END
  1345.       else
  1346.        BEGIN
  1347.         case UMsg^.code of
  1348.          $44,$26: BEGIN ergebnis:=true; ende:=true; END;
  1349.          $45,$36: BEGIN ergebnis:=false;ende:=true; END;
  1350.         else; end;
  1351.        END;
  1352.     else; end; {of case äußeres}
  1353.     Reply_Msg(UMsg);
  1354.     UNTIL ende=true;
  1355.    close_Window(WUni);
  1356. END;
  1357.  
  1358. {------------------------------------------------------------------------}
  1359.  
  1360. PROCEDURE Uebernehmen;
  1361.  
  1362. VAR WUe     : ^window;
  1363.     UeMsg   : ^IntuiMessage;
  1364.     G       : Gadget;
  1365.     RPUe    : ^RastPort;
  1366.     ende    : boolean;STATIC;
  1367.     gi,gc   : byte;STATIC;
  1368. BEGIN
  1369.  WUe:=Open_Window(130,11,510,245,1,GADGETUP,BORDERLESS+RMBTRAP,Nil,Scr,
  1370.                   510,245,510,245);
  1371.  GRand(WUe,0,0,508,244);
  1372.  RPUe:=WUe^.RPort;
  1373.  G:=Gadget(Nil,0,0,510,246,GADGHNONE,RELVERIFY+GADGIMMEDIATE,
  1374.            BOOLGADGET,NIL,NIL,NIL,0,NIL,1,NIL);
  1375.  WUe^.FIRSTGADGET:=^G;
  1376.  REFRESHGADGETS(WUe^.FIRSTGADGET,WUe,nil);
  1377.  SetAPen(RPUe,1);
  1378.  Move(RPUe,30,88);
  1379.  gfx:=_Text(RPUE,
  1380.  '<-- Bitte eines der Gadgets anwählen, damit der Eintrag',55);
  1381.  Move(RPUe,155,104);
  1382.  gfx:=_Text(RPUE,'Übernommen werden kann.',23);
  1383.  SetAPen(RPue,3);
  1384.  Move(RPUe,147,148);
  1385.  gfx:=_Text(RPUE,'--> Oder hier klicken. <--',26);
  1386.  ende:=false;
  1387.  REPEAT
  1388.   UeMsg:=Get_Msg(WUe^.UserPort);
  1389.   if UeMsg<>nil
  1390.    then
  1391.    BEGIN
  1392.     Reply_Msg(UeMsg);
  1393.     case UeMsg^.Class of
  1394.      GADGETUP: BEGIN ende:=true;
  1395.                      message('--> Eintrag nicht übernommen. <--'); END;
  1396.     else; end;
  1397.    END
  1398.    else
  1399.     BEGIN
  1400.     Msg:=Get_Msg(Win^.UserPort);
  1401.     if Msg<>nil
  1402.     then
  1403.      BEGIN
  1404.       Akt:=Msg^.IAddress;
  1405.       Reply_Msg(Msg);
  1406.       gi:=Akt^.GadgetID;
  1407.       gc:=Msg^.Code-1;
  1408.       case Msg^.class of
  1409.        GADGETUP :
  1410.         case gi of
  1411.           0..9: BEGIN
  1412.                  PosGadTx(gi,SGt[4]); ende:=true;
  1413.                  ein[(10*line)+gi].name1:=SGt[0];
  1414.                  ein[(10*line)+gi].name2:=SGt[1];
  1415.                  ein[(10*line)+gi].Nr:=SGt[2];
  1416.                  ein[(10*line)+gi].Ort:=SGt[3];
  1417.                  ein[(10*line)+gi].Kz:=SGt[4];
  1418.                  if not tosave then tosave:=true;
  1419.                 END;
  1420.           10: Wechseln;
  1421.         else end;
  1422.        RAWKEY   :
  1423.        case  gc  of
  1424.         0..9: BEGIN PosgadTx(gc,SGt[4]); ende:=true;
  1425.                ein[(10*line)+gc].name1:=SGt[0];
  1426.                ein[(10*line)+gc].name2:=SGt[1];
  1427.                ein[(10*line)+gc].Nr:=SGt[2];
  1428.                ein[(10*line)+gc].Ort:=SGt[3];
  1429.                ein[(10*line)+gc].Kz:=SGt[4];
  1430.                if not tosave then tosave:=true;
  1431.               END;
  1432.         $10: Wechseln;
  1433.        else; end;
  1434.       else;end;
  1435.      END;
  1436.     END;
  1437.  UNTIL ende;
  1438.  close_Window(WUe);
  1439. END;
  1440.  
  1441. {----------------------------------------------------------------------}
  1442.  
  1443. PROCEDURE Addyout(x:byte);
  1444.  BEGIN
  1445.   SGt[0]:=ein[(10*line)+x].name1;
  1446.   SGt[1]:=ein[(10*line)+x].name2;
  1447.   SGt[2]:=ein[(10*line)+x].Nr;
  1448.   SGt[3]:=ein[(10*line)+x].Ort;
  1449.   SGt[4]:=ein[(10*line)+x].Kz;
  1450.   REFRESHGADGETS(^SG[0],Win,nil);
  1451.  END;
  1452.  {---------------------------------------------------------------------}
  1453.  PROCEDURE Grundeinstellung;
  1454.   BEGIN
  1455.   ah[5]:=11;ah[6]:=11;ah[7]:=11;
  1456.   bh[5]:=0;bh[6]:=0;bh[7]:=0;
  1457.   ch[5]:=15;ch[6]:=15;ch[7]:=15;
  1458.   dh[5]:=6;dh[6]:=7;dh[7]:=13;
  1459.   line:=0;
  1460.   leerZh:=0;
  1461.   NLQu:=true;
  1462.   autoh:=true;
  1463.   Pfad:='';
  1464.   Datei:='';
  1465.   rufname:='';
  1466.  END;
  1467.  {---------------------------------------------------------------------}
  1468.  PROCEDURE NEU;
  1469.  BEGIN
  1470.   Loeschen;
  1471.   SGt[5]:='';
  1472.   for i:=0 to 49 do
  1473.    BEGIN
  1474.     ein[i].name1:='';
  1475.     ein[i].name2:='';
  1476.     ein[i].Nr:='';
  1477.     ein[i].Ort:='';
  1478.     ein[i].KZ:='';
  1479.    END;
  1480.   line:=0;
  1481.   if not toload then
  1482.    BEGIN
  1483.     for i:=0 to 9 do
  1484.      BEGIN
  1485.       S2[i]:='    frei    ';
  1486.       Gt[i]:=IntuiText(1,0,1,3,5,nil,^S2[i],nil);
  1487.      END;
  1488.     REFRESHGADGETS(Win^.Firstgadget,Win,nil);
  1489.     message('Datensätze alle gelöscht (NEU-Modus).');
  1490.    END;
  1491.   neues:=false;
  1492.   tosave:=false;
  1493.  END;
  1494.  {---------------------------------------------------------------------}
  1495.  PROCEDURE SaveListe;
  1496.  VAR sa:text;STATIC;
  1497.  BEGIN
  1498.   if tosave then
  1499.    BEGIN
  1500.     if arp then Filereq('Speichern der Adressen: ',Datei,Pfad)
  1501.      else if asl then AslReq('Speichern der Adressen: ',Datei,Pfad);
  1502.     if rufname<>''
  1503.      then
  1504.       BEGIN
  1505.        message('Versuche zu speichern...');
  1506.        rewrite(sa,rufname);
  1507.        If IOresult=0 then
  1508.         BEGIN
  1509.          writeln(sa,dk);                         {DateiKennung}
  1510.          writeln(sa,SGt[5]);                     {Abs}
  1511.          for i:=0 to 49 do
  1512.           if (ein[i].name1<>'') or (ein[i].name2<>'') or
  1513.              (ein[i].NR<>'')    or (ein[i].Ort<>'')   and
  1514.             ((ein[i].KZ<>'')    or (ein[i].KZ<>'frei'))
  1515.            then
  1516.             BEGIN
  1517.              writeln(sa,ein[i].name1);
  1518.              writeln(sa,ein[i].name2);
  1519.              writeln(sa,ein[i].Nr);
  1520.              writeln(sa,ein[i].Ort);
  1521.              writeln(sa,ein[i].KZ);
  1522.             END;
  1523.           close(sa);
  1524.           message('Adressen gespeichert unter: '+rufname);
  1525.          END
  1526.         else message('Konnte File nicht eröffen...');
  1527.       END;
  1528.     END
  1529.    else message('Keine Eintragungen bisher gemacht');
  1530.  END;
  1531. {---------------------------------------------------------------------}
  1532.  PROCEDURE LadeListe;
  1533.  VAR lo:text;STATIC;
  1534.      t:string;STATIC;
  1535.      z,y:byte;STATIC;
  1536.   BEGIN
  1537.     if not autofirst then
  1538.      if arp then Filereq('Laden der Adressen: ',Datei,Pfad)
  1539.       else if asl then AslReq('Laden der Adressen: ',Datei,Pfad);
  1540.     if rufname<>''
  1541.      then
  1542.       BEGIN
  1543.        toload:=true;
  1544.        if not autofirst then message('Lade...');
  1545.        z:=0;
  1546.        reset(lo,rufname);
  1547.        If IOresult=0 then
  1548.         BEGIN
  1549.          readln(lo,t);                          {DateiKennung ?}
  1550.          if t=dk then
  1551.           BEGIN
  1552.            NEU;
  1553.            i:=0;
  1554.            readln(lo,SGt[5]);                   {Abs}
  1555.            REPEAT
  1556.              readln(lo,ein[i].name1);
  1557.              readln(lo,ein[i].name2);
  1558.              readln(lo,ein[i].Nr);
  1559.              readln(lo,ein[i].Ort);
  1560.              readln(lo,ein[i].KZ);
  1561.              Inc(z);
  1562.              Inc(i)
  1563.            UNTIL eof(lo);
  1564.            if z<10 then y:=z else y:=10;
  1565.            for i:=0 to 9 do
  1566.               BEGIN
  1567.                S2[i]:='            ';
  1568.                Gt[i]:=IntuiText(1,0,1,3,5,nil,^S2[i],nil);
  1569.               END;
  1570.               REFRESHGADGETS(Win^.Firstgadget,Win,nil);
  1571.             for i:=0 to y-1 do
  1572.              BEGIN
  1573.               S2[i]:=ein[i].Kz;
  1574.               help:=(10-(STRLEN(S2[i])));
  1575.               Gt[i]:=IntuiText(1,0,1,((4*help)+11),5,nil,^S2[i],nil);
  1576.              END;
  1577.             if z<10 then
  1578.              for i:=z to 9 do
  1579.               BEGIN
  1580.                S2[i]:='    frei    ';
  1581.                Gt[i]:=IntuiText(1,0,1,3,5,nil,^S2[i],nil);
  1582.               END;
  1583.             REFRESHGADGETS(Win^.Firstgadget,Win,nil);
  1584.             message('Geladen: '+rufname);
  1585.             tosave:=true;
  1586.           END
  1587.          else message('Keine APrintV1.1 Datei');
  1588.          close(lo);
  1589.        END
  1590.       else message('Konnte Datei nicht öffnen');
  1591.      END;
  1592.     toload:=false;
  1593.  END;
  1594.  
  1595. {******************************** Main *******************************}
  1596.  
  1597. BEGIN
  1598.   suchelib;
  1599.   if arp then openlib(arpbase,'arp.library',0)
  1600.    else if asl then OpenLib(AslBase,ASLNAME,36)
  1601.     else
  1602.       BEGIN
  1603.        lab1:=INTUITEXT(2,1,0,40,15,NIL,'  APrint V1.1 benötigt die',^lab2);
  1604.        lab2:=INTUITEXT(2,1,0,40,25,NIL,'ARP (OS1.3) oder ASL.LIBRARY',NIL);
  1605.        fehlerreq;
  1606.        exit;
  1607.       END;
  1608.   if (arpbase=NIL) or (ASLBASE=NIL) then
  1609.      BEGIN
  1610.        lab1:=INTUITEXT(2,1,0,40,15,NIL,'   Fehler beim öffnen von',^lab2);
  1611.        lab2:=INTUITEXT(2,1,0,40,25,NIL,'ARP (OS1.3) oder ASL.LIBRARY',NIL);
  1612.        fehlerreq;
  1613.        exit;
  1614.       END;
  1615.   line:=0;
  1616.   tosave:=false;
  1617.   loadcon;
  1618.   if fehl then Grundeinstellung;
  1619.   Hauptwin;
  1620.   Win^.Firstgadget:=^G[0];
  1621.   REFRESHGADGETS(Win^.Firstgadget,Win,nil);
  1622.  
  1623.   if (autoh) and (rufname<>'') then
  1624.    BEGIN autofirst:=true;
  1625.          message('AutoLoad-Modus. Bitte warten lade: '+rufname);
  1626.          LadeListe
  1627.    END;
  1628.   autofirst:=false;
  1629.  
  1630.   ex:=false;
  1631.  
  1632.   REPEAT
  1633.     Msg:=Get_Msg(Win^.UserPort);
  1634.     if Msg<>nil
  1635.      then
  1636.       BEGIN
  1637.        Akt:=Msg^.IAddress;
  1638.        ig:=Akt^.GadgetID;
  1639.        cg:=Msg^.Code;
  1640.        Reply_Msg(Msg);
  1641.        case Msg^.class of
  1642.         GADGETUP :
  1643.          case ig of
  1644.           0..9: Addyout(ig);
  1645. {@}       10: Wechseln;
  1646. {name1}   11: strw:=ActivateGadget(^SG[1],Win,Nil);
  1647. {name2}   12: strw:=ActivateGadget(^SG[2],Win,Nil);
  1648. {straße}  13: strw:=ActivateGadget(^SG[3],Win,Nil);
  1649. {ort}     14: strw:=ActivateGadget(^SG[4],Win,Nil);
  1650. {Kürzel}  15: BEGIN
  1651.               frei:=true;
  1652.               for i:=0 to  4 do if frei then
  1653.                                 if SGt[i]<>'' then frei:=false;
  1654.               if not frei
  1655.                then Uebernehmen
  1656.                else message('--> Es gibt nichts zum Übernehmen <--');
  1657.              END;
  1658. {Info}    17: Infoline;
  1659. {Save}    18: SaveListe;
  1660. {PRT:}    19: Drucken;
  1661. {ENDE}    20: BEGIN UniWin(227,48,26,5,18,5,32,10,23,10,'Ende','Zurück',
  1662.                            'APrint verlassen ???',1);
  1663.               if ergebnis then ex:=true;
  1664.               END;
  1665. {CLI}     21: ToCli;
  1666. {Loe}     23: Loeschen;
  1667. {NEU}     24: BEGIN UniWin(227,48,34,5,26,5,40,10,32,10,'Ja','Nein',
  1668.                            'Neu: Daten löschen ?',0);
  1669.                      if ergebnis then BEGIN neues:=true; Neu; END;END;
  1670.           25: LadeListe;
  1671.           26: Prefs;
  1672.  
  1673.           else;end;
  1674.  
  1675.          RAWKEY   :
  1676.           case cg  of
  1677.           $45,$12:
  1678.             BEGIN UniWin(227,48,26,5,18,5,32,10,23,10,'Ende','Zurück',
  1679.                            'APrint verlassen ???',1);
  1680.                   if ergebnis then ex:=true;
  1681.             END;                                     {Ende:       ESC/E}
  1682.           $22:         Drucken;                      {Drucken     D}
  1683.           $17:         Infoline;                     {Info:       I}
  1684.           $25:         ToCli;                        {Sleep:      H}
  1685.           $29: Loeschen;                             {Löschen:    Ö}
  1686.           $01..$0A: Addyout(cg-1);                   {AdrGads:  1..0}
  1687.           $21: SaveListe;                            {Speichern:  S}
  1688.  
  1689.           $36: BEGIN UniWin(227,48,34,5,26,5,40,10,32,10,'Ja','Nein',
  1690.                            'Neu: Daten löschen ?',0);
  1691.                      if ergebnis then BEGIN neues:=true; Neu; END; END;
  1692.                                                      {Neu:        N}
  1693.           $19: Prefs;                                {Prefs:      P}
  1694.           $28: LadeListe;                            {laden:      L}
  1695.  
  1696.         $15:;                                      {Z-->R:      Z}
  1697.         $11: Wechseln;                             {@:          W}
  1698.         $20: strw:=ActivateGadget(^SG[0],Win,Nil); {Name1:      A}
  1699.         $37: strw:=ActivateGadget(^SG[1],Win,Nil); {Name2:      M}
  1700.         $0b: strw:=ActivateGadget(^SG[2],Win,Nil); {Straße:     ß}
  1701.         $18: strw:=ActivateGadget(^SG[3],Win,Nil); {Ort:        O}
  1702.         $27: strw:=ActivateGadget(^SG[4],Win,Nil); {Kürzel:     K}
  1703.         $35: strw:=ActivateGadget(^SG[5],Win,Nil); {Abs.:       B}
  1704.        else;end;
  1705.       otherwise
  1706.     end;
  1707.    END;
  1708.   until ex=true;
  1709.  
  1710.   Prc^.pr_WindowPtr:=OWin;
  1711.  
  1712.   if asl then CloseLib(AslBase)
  1713.    else if arp then CloseLib(ArpBase);
  1714.   Close_Window(Win);
  1715.   Close_Screen(Scr);
  1716.  
  1717.   Free_Mem(LONG(iradio1),SizeOf(iradiofeld));
  1718.   Free_Mem(LONG(iradio2),SizeOf(iradiofeld));
  1719.   Free_Mem(LONG(ipfeil),SizeOf(ipffeld));
  1720. END.
  1721.